Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue45/Alfresco/AALZCmpr.pas

Pascal/Delphi Source File | 2000-11-02 | 10.5 KB | 322 lines

{*********************************************************}
{* AALZCmpr                                              *}
{* Copyright (c) Julian M Bucknall 1998-1999             *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Algorithms Alfresco LZ77 unit - Compress/decompress   *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AALZCmpr;

interface

uses
  SysUtils,
  Classes,
  AALZBase;

procedure AALZCompress(aInStream, aOutStream : TStream);
  {Compress the input stream to the output stream using LZ77 compression}

procedure AALZDecompress(aInStream, aOutStream : TStream);
  {Decompress the input stream to the output stream using LZ77 compression}

implementation

{Notes: A distance/length encoding consists of two parts: the distance
        and the length. The distance varies from 1 to 8192, and the
        length from 3 to 10. To store both these values into a 16-bit
        entity, we subtract 1 from the distance value (to force it in
        the range 0 to 8191, or $0000 to $1FFF) and shift it left by 3
        bits. We subtract 3 from the length (to force it in the range
        0 to 7) and add it to the modified distance value. The
        resulting 16-bit value is then written.
        To unpack the two values on reading, perform the opposite. AND
        $7 to the 16-bit value, and add 3 for the length. Shift the
        16-bit value right by 3 bits and add 1 for the distance.}

uses
  AALZSWin,
  AALZHash;

const
  AALZHeader = $5A4C4141; {the header for the compressed result}

type
  PEnumExtraData = ^TEnumExtraData;    {extra data record for the    }
  TEnumExtraData = packed record       {  hash table's FindAll method}
    edSW          : TaaLZSlidingWindow;{..sliding window object}
    edMaxLen      : integer;           {..maximum match length so far}
    edDistMaxMatch: integer;           {..distance of max match}
  end;

type
  TEncoding = packed record
    AsDistLen : integer;
    AsChar    : char;
    IsChar    : boolean;
    {$IFDEF WIN32}
    Filler    : word;
    {$ENDIF}
  end;
  TEncodingArray = array [0..7] of TEncoding;

{===Stream read/write routines with exceptions=======================}
procedure StreamRead(aStream : TStream;
                 var aBuffer;
                     aBufLen : integer);
var
  BytesRead : longint;
begin
  BytesRead := aStream.Read(aBuffer, aBufLen);
  if (BytesRead <> aBufLen) then
    raise Exception.Create('Stream read error: not enough data read');
end;
{--------}
procedure StreamWrite(aStream : TStream;
                  var aBuffer;
                      aBufLen : integer);
var
  BytesWrit : longint;
begin
  BytesWrit := aStream.Write(aBuffer, aBufLen);
  if (BytesWrit <> aBufLen) then
    raise Exception.Create('Stream write error: not enough data written (disk full?)');
end;
{====================================================================}


{===Helper routines==================================================}
procedure MatchLongest(aExtraData : pointer;
                 const aKey       : TaaLZKey;
                       aOffset    : longint); far;
var
  Len  : integer;
  Dist : integer;
begin
  with PEnumExtraData(aExtraData)^ do begin
    Len := edSW.Compare(aOffset, Dist);
    if (Len > edMaxLen) then begin
      edMaxLen := Len;
      edDistMaxMatch := Dist;
    end;
  end;
end;
{--------}
procedure WriteEncodings(aStream    : TSTream;
                     var aEncodings : TEncodingArray;
                         aCount     : integer);
var
  i : integer;
  FlagByte : byte;
  Mask     : byte;
begin
  {build flag byte, write it to the stream}
  FlagByte := 0;
  Mask := 1;
  for i := 0 to pred(aCount) do begin
    if not aEncodings[i].IsChar then
      FlagByte := FlagByte or Mask;
    Mask := Mask shl 1;
  end;
  StreamWrite(aStream, FlagByte, sizeof(FlagByte));
  {write out the encodings}
  for i := 0 to pred(aCount) do begin
    if aEncodings[i].IsChar then
      StreamWrite(aStream, aEncodings[i].AsChar, 1)
    else
      StreamWrite(aStream, aEncodings[i].AsDistLen, 2);
  end;
end;
{--------}
procedure AddCharToEncodings(aStream : TStream;
                                 aCh : char;
                      var aEncodings : TEncodingArray;
                      var aCount     : integer);
begin
  aEncodings[aCount].AsChar := aCh;
  aEncodings[aCount].IsChar := true;
  inc(aCount);
  if (aCount = 8) then begin
    WriteEncodings(aStream, aEncodings, 8);
    aCount := 0;
  end;
end;
{--------}
procedure AddCodeToEncodings(aStream   : TStream;
                             aDistance : integer;
                             aLength   : integer;
                        var aEncodings : TEncodingArray;
                        var aCount     : integer);
begin
  aEncodings[aCount].AsDistLen :=
     (pred(aDistance) shl aalzDistanceShift) + (aLength - 3);
  aEncodings[aCount].IsChar := false;
  inc(aCount);
  if (aCount = 8) then begin
    WriteEncodings(aStream, aEncodings, 8);
    aCount := 0;
  end;
end;
{====================================================================}


{===Interfaced routines==============================================}
procedure AALZCompress(aInStream, aOutStream : TStream);
var
  HashTable : TaaLZHashTable;
  SlideWin  : TaaLZSlidingWindow;
  Key       : TaaLZKey;
  Offset    : longint;
  CodeCount : integer;
  Encodings : TEncodingArray;
  EnumData  : TEnumExtraData;
  LongValue : longint;
  i         : integer;
begin
  HashTable := TaaLZHashTable.Create;
  try
    SlideWin := TaaLZSlidingWindow.Create(aInStream, true);
    try
      {write the header to the stream: 'AALZ' followed by uncompressed
       size of input stream}
      LongValue := AALZHeader;
      StreamWrite(aOutStream, LongValue, sizeof(LongValue));
      LongValue := aInStream.Size;
      StreamWrite(aOutStream, LongValue, sizeof(LongValue));
      {prepare for the compression}
      CodeCount := 0;
      FillChar(Encodings, sizeof(Encodings), 0);
      {get the first key}
      SlideWin.GetNextKey(Key, Offset);
      {while the key is three characters long...}
      while (length(Key.AsString) = 3) do begin
        {find the longest match in the sliding window using the hash
         table to identify matches}
        EnumData.edSW := SlideWin;
        EnumData.edMaxLen := 0;
        if HashTable.FindAll(Key,
                             Offset - aalzSlidingWindowSize,
                             MatchLongest,
                             @EnumData) then begin
          {we have a match: save the distance/length pair and advance
           the sliding window by the length}
          AddCodeToEncodings(aOutStream,
                             EnumData.edDistMaxMatch,
                             EnumData.edMaxLen,
                             Encodings, CodeCount);
          SlideWin.Advance(EnumData.edMaxLen);
        end
        else begin
          {we don't have a match: save the current character and
           advance by 1}
          AddCharToEncodings(aOutStream,
                             Key.AsString[1],
                             Encodings, CodeCount);
          SlideWin.Advance(1);
        end;
        {now add this key to the hash table}
        HashTable.Insert(Key, Offset);
        {get the next key}
        SlideWin.GetNextKey(Key, Offset);
      end;
      {if the last key was two characters or less, save them as
       literal character encodings}
      if (length(Key.AsString) > 0) then begin
        for i := 1 to length(Key.AsString) do
          AddCharToEncodings(aOutStream,
                             Key.AsString[i],
                             Encodings, CodeCount);
      end;
      {make sure we write out the final encodings}
      if (CodeCount > 0) then
        WriteEncodings(aOutStream, Encodings, CodeCount);
    finally
      SlideWin.Free;
    end;{try..finally}
  finally
    HashTable.Free;
  end;{try..finally}
end;
{--------}
procedure AALZDecompress(aInStream, aOutStream : TStream);
type
  TModeState = (msGetFlagByte, msGetChar, msGetDistLen);
var
  SlideWin      : TaaLZSlidingWindow;
  BytesUnpacked : longint;
  TotalSize     : longint;
  LongValue     : longint;
  ModeState     : TModeState;
  FlagByte      : byte;
  FlagMask      : byte;
  NextChar      : char;
  NextDistLen   : longint;
  CodeCount     : integer;
  Len           : integer;
begin
  SlideWin := TaaLZSlidingWindow.Create(aOutStream, false);
  try
    {read the header from the stream: 'AALZ' followed by uncompressed
     size of input stream}
    StreamRead(aInStream, LongValue, sizeof(LongValue));
    if (LongValue <> AALZHeader) then
      raise Exception.Create('not a AALZ file - no header');
    StreamRead(aInStream, TotalSize, sizeof(TotalSize));
    {prepare for the decompression}
    BytesUnpacked := 0;
    NextDistLen := 0;
    ModeState := msGetFlagByte;
    CodeCount := 0;
    FlagMask := 1;
    {while there are still bytes to decompress...}
    while (BytesUnpacked < TotalSize) do begin
      {read the next item}
      case ModeState of
        msGetFlagByte :
          begin
            StreamRead(aInStream, FlagByte, 1);
            CodeCount := 0;
            FlagMask := 1;
          end;
        msGetChar :
          begin
            StreamRead(aInStream, NextChar, 1);
            SlideWin.AddChar(NextChar);
            inc(BytesUnpacked);
          end;
        msGetDistLen :
          begin
            StreamRead(aInStream, NextDistLen, 2);
            Len := (NextDistLen and aalzLengthMask) + 3;
            SlideWin.AddCode((NextDistLen shr aalzDistanceShift) + 1, Len);
            inc(BytesUnpacked, Len);
          end;
      else
        raise Exception.Create('AALZDecompress.ModeState has an invalid value');
      end;
      {calculate the next mode state}
      inc(CodeCount);
      if (CodeCount > 8) then
        ModeState := msGetFlagByte
      else begin
        if ((FlagByte and FlagMask) = 0) then
          ModeState := msGetChar
        else
          ModeState := msGetDistLen;
        FlagMask := FlagMask shl 1;
      end;
    end;
  finally
    SlideWin.Free;
  end;{try..finally}
end;
{====================================================================}


end.